home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tp5tsr.zip / TSRDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1989-05-27  |  10KB  |  238 lines
  1. PROGRAM TSRDemo;  {An example TSR program created using TSRUnit.   }
  2.  
  3. {$M $0800,0,0}   {Set stack and heap size for demo program.        }
  4.  
  5. USES CRT, DOS, TSRUNIT; {Specify the TSRUNIT in the USES statement.}
  6.                         {Do not use the PRINTER unit, instead treat}
  7.                         {the printer like a file; i.e. use the     }
  8.                         {Assign, Rewrite, and Close procedures.    }
  9.  
  10. CONST  DemoPgmName : STRING[16] = 'TSR Demo Program';
  11.  
  12. VAR
  13.   Lst      : TEXT;      {Define variable name for the printer.     }
  14.   TextFile : TEXT;      {  "        "     "    "   a data file.    }
  15.   InsStr   : STRING;    {Storage for characters to be inserted into}
  16.                         {keyboard input stream--must be a gobal or }
  17.                         {heap variable.                            }
  18.  
  19. FUNCTION IOError: BOOLEAN;    {Provides a message when an I/O error}
  20. VAR  i : WORD;                {occurs.                             }
  21. BEGIN
  22.   i       := IOResult;
  23.   IOError := FALSE;
  24.   IF i <> 0 THEN BEGIN
  25.     Writeln('I/O Error No. ',i);
  26.     IOError := TRUE;
  27.   END;
  28. END;  {OurIOResult.}
  29. {
  30. ***** Demo routine to be called when TSRDemo is popped up.
  31.       be compiled as a FAR FUNCTION that returns a WORD containing
  32.       the number of characters to insert into the keyboard input
  33.       stream.
  34. }
  35. {$F+} FUNCTION DemoTasks: WORD; {$F-}
  36. CONST
  37.   FileName : STRING[13] = ' :TSRDemo.Dat';
  38.   EndPos = 40;
  39.   Wx1 = 15; Wy1 = 2;   Wx2 = 65; Wy2 = 23;
  40. VAR
  41.   Key, Drv          : CHAR;
  42.   Done, IOErr       : BOOLEAN;
  43.   InputPos, RowNumb : INTEGER;
  44.   DosVer            : WORD;
  45.   InputString       : STRING;
  46.  
  47.   PROCEDURE ClearLine; {Clears current line and resets line pointer}
  48.   BEGIN
  49.     InputString := '';     InputPos := 1;
  50.     GotoXY( 1, WhereY );   ClrEol;
  51.   END;
  52.  
  53. BEGIN
  54.   DemoTasks   := 0;             {Default to 0 characters to insert.}
  55.   Window( Wx1, Wy1, Wx2, Wy2 ); {Set up the screen display.        }
  56.   TextColor( Black );
  57.   TextBackground( LightGray );
  58.   LowVideo;
  59.   ClrScr;                      {Display initial messages.          }
  60.   Writeln;
  61.   Writeln('  Example Terminate & Stay-Resident (TSR) program');
  62.   Writeln(' --written with Turbo Pascal 5.0 and uses TSRUnit.');
  63.   Window( Wx1+1, Wy1+4, Wx2-1, Wy1+12);
  64.   TextColor( LightGray );
  65.   TextBackground( Black );
  66.   ClrScr;                      {Display function key definitions.  }
  67.   Writeln;
  68.   Writeln('    Function key definitions:');
  69.   Writeln('        [F1]  Write message to TSRDEMO.DAT');
  70.   Writeln('        [F2]    "     "     to printer.');
  71.   Writeln('        [F3]  Read from saved screen.');
  72.   Writeln('        [F8]  Exit and insert text.');
  73.   Writeln('        [F10] Exit TSR and keep it.');
  74.   Write(  '        or simply echo your input.');
  75.  
  76.                                {Create active display window.      }
  77.   Window( Wx1+1, Wy1+14, Wx2-1, Wy2-1 );
  78.   ClrScr;
  79.                                {Display system information.        }
  80.   Writeln('TSRUnit Version: ', Hi(TSRVersion):8, '.',
  81.                                Lo(TSRVersion):2 );
  82.   Writeln('Video Mode, Page:', TSRMode:4, TSRPage:4 );
  83.   Writeln('Cursor Row, Col.:', TSRRow:4, TSRColumn:4 );
  84.  
  85.   DosVer := DosVersion;
  86.   Writeln('DOS Version:     ', Lo(DosVer):8, '.', Hi(DosVer):2 );
  87.  
  88.   InputString := '';          {Initialize variables.               }
  89.   InputPos    := 1;
  90.   Done        := False;
  91.  
  92.   REPEAT                      {Loop for processing keystrokes.     }
  93.     GotoXY( InputPos, WhereY );    {Move cursor to input position. }
  94.     Key := ReadKey;                {Wait for a key to be pressed.  }
  95.     IF Key = #0 THEN BEGIN         {Check for a special key.       }
  96.       Key := ReadKey;              {If a special key, get auxiliary}
  97.       CASE Key OF                  {byte to identify key pressed.  }
  98.  
  99. {Cursor Keys and simple editor.}
  100. {Home}  #71: InputPos := 1;
  101. {Right} #75: IF InputPos > 1 THEN Dec( InputPos );
  102. {Left}  #77: IF (InputPos < Length( InputString ))
  103.                 OR ((InputPos = Length( InputString ))
  104.                     AND (InputPos < EndPos )) THEN Inc( InputPos );
  105. {End}   #79: BEGIN
  106.                InputPos := Succ( Length( InputString ) );
  107.                IF InputPos > EndPos THEN InputPos := EndPos;
  108.              END;
  109. {Del}   #83: BEGIN
  110.                Delete( InputString, InputPos, 1 );
  111.                Write( Copy( InputString, InputPos, EndPos ), ' ');
  112.              END;
  113.  
  114. {Function Keys--TSRDemo's special features.}
  115. {F1}    #59: BEGIN                 {Write short message to a file. }
  116.                ClearLine;
  117.                REPEAT
  118.                  Write('Enter disk drive:  ',FileName[1] );
  119.                  Drv := UpCase( ReadKey );  Writeln;
  120.                  IF Drv <> #13 THEN FileName[1] := Drv;
  121.                  Writeln('Specifying an invalid drive will cause your');
  122.                  Write('system to crash.  Use drive ',
  123.                         FileName[1], ': ?  [y/N] ');
  124.                  Key := UpCase( ReadKey );  Writeln( Key );
  125.                UNTIL Key = 'Y';
  126.                Writeln('Writing to ',FileName );
  127.                {$I-}                         {Disable I/O checking.}
  128.                Assign( TextFile, 'TSRDemo.Dat' );
  129.                IF NOT IOError THEN BEGIN     {Check for error.     }
  130.                  Rewrite( TextFile );
  131.                  IF NOT IOError THEN BEGIN
  132.                    Writeln(TextFile,'File was written by TSRDemo.');
  133.                    IOErr := IOError;
  134.                    Close( TextFile );
  135.                    IOErr := IOError;
  136.                  END;
  137.                END;
  138.                {$I+}                 {Enable standard I/O checking.}
  139.                Writeln('Completed file operation.');
  140.              END;  {F1}
  141.  
  142. {F2}    #60: BEGIN {Print a message, use TSRUnit's auxiliary       }
  143.                    {function PrinterOkay to check printer status.  }
  144.                ClearLine;
  145.                Writeln('Check printer status, then print if okay.');
  146.                IF PrinterOkay THEN BEGIN  {Check if printer is okay}
  147.                  Assign( Lst, 'LPT1' );   {Define printer device.  }
  148.                  Rewrite( Lst );          {Open printer.           }
  149.                  Writeln( Lst, 'Printing performed from TSRDemo');
  150.                  Close( Lst );            {Close printer.          }
  151.                END
  152.                ELSE Writeln('Printer is not ready.');
  153.                Writeln( 'Completed print operation.' );
  154.              END;  {F2}
  155.  
  156. {F3}    #61: BEGIN {Display a line from the saved screen image--not}
  157.                    {valid if the TSR was popped up while the       }
  158.                    {display was in a graphics mode.                }
  159.                ClearLine;
  160.                CASE TSRMode OF    {Check video mode of saved image.}
  161.                  0..3,
  162.                  7: BEGIN
  163.                       {$I-}
  164.                       REPEAT
  165.                         Writeln('Enter row number [1-25] from ');
  166.                         Write('which to copy characters:  ');
  167.                         Readln( RowNumb );
  168.                       UNTIL NOT IOError;
  169.                       {$I+}
  170.                       IF RowNumb <= 0 THEN RowNumb := 1;
  171.                       IF RowNumb > 25 THEN RowNumb := 25;
  172.                       Writeln( ScreenLineStr( RowNumb ) );
  173.                     END;
  174.                ELSE Writeln('Not valid for graphics modes.');
  175.                END;  {CASE TSRMode}
  176.              END;  {F3}
  177. {F8}    #66: BEGIN {Exit and insert string into keyboard buffer.}
  178.                ClearLine;
  179.                Writeln('Enter characters to insert;');
  180.                Writeln('Up to 255 character may be inserted.');
  181.                Writeln('Terminate input string by pressing [F8].');
  182.                InsStr := '';
  183.                REPEAT                     {Insert characters into a}
  184.                  Key := ReadKey;          {until [F8] is pressed.  }
  185.                  IF Key = #0 THEN BEGIN     {Check for special key.}
  186.                    Key := ReadKey;          {Check if key is [F8]. }
  187.                    IF Key = #66 THEN Done := TRUE; {[F8] so done.  }
  188.                  END
  189.                  ELSE BEGIN {Not special key, add it to the string.}
  190.                    IF Length(InsStr) < Pred(SizeOf(InsStr)) THEN
  191.                    BEGIN
  192.                      IF Key = #13 THEN Writeln
  193.                      ELSE Write( Key );
  194.                      InsStr := InsStr + Key;
  195.                    END
  196.                    ELSE Done := TRUE; {Exceeded character limit.   }
  197.                  END;
  198.                UNTIL Done;
  199.                DemoTasks := Length( InsStr );  {Return no. of chr. }
  200.                TSRChrPtr := @InsStr[1];        {Set ptr to 1st chr.}
  201.              END;  {F8}
  202.  
  203. {F10}   #68: Done := TRUE; {Exit and Stay-Resident.                }
  204.  
  205.       END;  {CASE Key}
  206.     END  {IF Key = #0}
  207.     ELSE BEGIN   {Key pressed was not a special key--just echo it. }
  208.       CASE Key OF
  209. {BS}    #08: BEGIN  {Backspace}
  210.                IF InputPos > 1 THEN BEGIN
  211.                  Dec( InputPos );
  212.                  Delete( InputString, InputPos, 1 );
  213.                  GotoXY( InputPos, WhereY );
  214.                  Write( Copy( InputString, InputPos, EndPos ), ' ');
  215.                END;
  216.              END;  {BS}
  217. {CR}    #13: BEGIN  {Enter}
  218.                Writeln;
  219.                InputString := '';
  220.                InputPos    := 1;
  221.              END;  {CR}
  222. {Esc}   #27: ClearLine;
  223.       ELSE
  224.         IF Length( InputString ) >= EndPos THEN
  225.           Delete( InputString, EndPos, 1 );
  226.         Insert( Key, InputString, InputPos );
  227.         Write( Copy( InputString, InputPos, EndPos ) );
  228.         IF InputPos < EndPos THEN
  229.           Inc( InputPos );
  230.       END;  {CASE...}
  231.     END;  {ELSE BEGIN--Key <> #0}
  232.     UNTIL Done;
  233. END;  {DemoTasks.}
  234.  
  235. BEGIN
  236.   TSRInstall( DemoPgmName, DemoTasks, AltKey, 'E' );
  237. END.  {TSRDemo.}
  238.